(* ========================================================================
                     Universal Stream Package Format

     Collection of packages with deferred load ability (load on request)
     and unified entry request method.
   ------------------------------------------------------------------------
     File: uPackageCollection.pas
     Copyright: (c) 2010, TSX Software
     License: Freeware
   ======================================================================== *)
unit uPackageCollection;

interface

uses Windows, Classes, SysUtils, uPackage;

type
  TUSFPackageLoadInfo = record
    FileName: string;
    Version: word;
    Name: TUSFIdentifier;
    PkObject: TUSFPackage;
  end;
  PUSFPackageLoadInfo = ^TUSFPackageLoadInfo;

  TUSFPackageCollection = class
  private
    FItems: TList;
    FPkClass: TUSFPackageClass;
    FDeferLoad: boolean;
    function RCount: integer;
    function REntryByName(Name: string): TUSFPackageEntry;
    function RPackByIndex(index: integer): TUSFPackage;
    function RPackByName(Name: TUSFIdentifier): TUSFPackage;
  protected
    function IndexOf(const Name: TUSFIdentifier): integer;
    function LoadPackageFile(const index: integer): boolean;
  public
    constructor Create(const PackageClass: TUSFPackageClass);
    destructor Destroy; override;

    procedure LoadPackages(const SearchPath: string);
    procedure UnloadPackage(const Name: TUSFIdentifier);
    procedure UnloadAll;
    procedure Clear;

    property Count: integer read RCount;
    property PackageByIndex[index: integer]: TUSFPackage read RPackByIndex;
    property PackageByName[Name: TUSFIdentifier]: TUSFPackage read RPackByName;

    //GalaxyMap.Planet01
    property EntryByName[Name: string]: TUSFPackageEntry read REntryByName;
  published
    property DeferredLoading: boolean read FDeferLoad write FDeferLoad;
    property PackageClass: TUSFPackageClass read FPkClass;
  end;

implementation

{ TUSFPackageCollection }

procedure TUSFPackageCollection.Clear;
begin
  UnloadAll;
  while FItems.Count>0 do begin
    FreeMem(FItems[0]);
    FItems.Delete(0);
  end;
end;

constructor TUSFPackageCollection.Create(
  const PackageClass: TUSFPackageClass);
begin
  FItems := TList.Create;
  FPkClass := PackageClass;
end;

destructor TUSFPackageCollection.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TUSFPackageCollection.IndexOf(
  const Name: TUSFIdentifier): integer;
var i: integer;
begin
  Result := -1;
  for i := 0 to FItems.Count-1 do
    if SameText(RPackByIndex(i).PackageName, Name) then begin
      Result := i;
      break;
    end;
end;

function TUSFPackageCollection.LoadPackageFile(const index: integer): boolean;
begin
  Result := Assigned(PUSFPackageLoadInfo(FItems[index])^.PkObject);
  if Result then exit;
  
  try
    PUSFPackageLoadInfo(FItems[index])^.PkObject := FPkClass.Create(PUSFPackageLoadInfo(FItems[index])^.FileName);
    Result := true;
  except Result := false; end;
end;

procedure TUSFPackageCollection.LoadPackages(const SearchPath: string);

  procedure _load(path: string);
  var sr: TSearchRec;
      dl: PUSFPackageLoadInfo;
      pk: TUSFIdentifier;
      pv: word;
  begin
    path := IncludeTrailingPathdelimiter(path);
    if FindFirst(path+'*.*', faAnyFile, sr) = 0 then begin
      repeat
        if (sr.Name <> '.') and (sr.Name <> '..') then
          if (sr.Attr and faDirectory = faDirectory) then _load(path+sr.Name)
          else
            if ReadPackageInfo(path+sr.Name, pk, pv) then begin
              // Creating DeferredLoad info
              new(dl);
              dl^.FileName := path+sr.Name;
              dl^.Version := pv;
              dl^.Name := pk;
              dl^.PkObject := nil;
              FItems.Add(dl);
              // Load package instantly?
              if not self.DeferredLoading then
                self.LoadPackageFile(FItems.Count-1);
            end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;

begin
  _load(SearchPath);
end;

function TUSFPackageCollection.RCount: integer;
begin
  Result := FItems.Count;
end;

function TUSFPackageCollection.REntryByName(
  Name: string): TUSFPackageEntry;
var PkName,EnName: string;
    PkI: TUSFPackage;
begin
  Result := nil;
  if Pos('.', Name) = 0 then exit;

  PkName := copy(Name,1,pos('.',Name)-1);
  EnName := copy(Name,pos('.',Name)+1, 255);
  if (PkName = '') or (EnName = '') then exit;

  PkI := RPackByName(PkName);
  if Assigned(PkI) then
    Result := PkI.Entry[EnName];
end;

function TUSFPackageCollection.RPackByIndex(index: integer): TUSFPackage;
begin
  Result := PUSFPackageLoadInfo(FItems[index])^.PkObject;
  if not Assigned(Result) then
    // Package not loaded, try loading
    if Self.LoadPackageFile(index) then
      Result := PUSFPackageLoadInfo(FItems[index])^.PkObject;
end;

function TUSFPackageCollection.RPackByName(
  Name: TUSFIdentifier): TUSFPackage;
var i: integer;
begin
  Result := nil;
  // Search in loaded packages
  i := IndexOf(Name);
  if i > -1 then Result := RPackByIndex(i);
end;

procedure TUSFPackageCollection.UnloadAll;
var i: integer;
begin
  for i := 0 to FItems.Count-1 do
    if Assigned(PUSFPackageLoadInfo(FItems[i])^.PkObject) then begin
      PUSFPackageLoadInfo(FItems[i])^.PkObject.Free;
      PUSFPackageLoadInfo(FItems[i])^.PkObject := nil;
    end;
end;

procedure TUSFPackageCollection.UnloadPackage(const Name: TUSFIdentifier);
var i: integer;
begin
  i := indexOf(Name);
  if i > -1 then
    if Assigned(PUSFPackageLoadInfo(FItems[i])^.PkObject) then begin
      PUSFPackageLoadInfo(FItems[i])^.PkObject.Free;
      PUSFPackageLoadInfo(FItems[i])^.PkObject := nil;
    end;
end;

end.